home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / dcd.zip / dcd / dcd.cmd next >
OS/2 REXX Batch file  |  1997-08-11  |  33KB  |  736 lines
  1. /*
  2.    @ECHO OFF
  3.    ECHO DCD Error: OS/2 Procedures Language 2/REXX not installed.
  4.    pause
  5.    exit
  6. ==============================================================================
  7. DCD - Disk Change Directory
  8. For usage type 'DCD', 'DCD -?', 'DCD -help', or read DCD.DOC.
  9. Roger de Reus (reus@mic.dtu.dk)
  10. ==============================================================================
  11. */
  12. DCD.Version=,
  13. 'DCD disk change directory -- v2.00 -- Copyright (c)1995-1997 Roger de Reus '
  14.  
  15. /* -------------- Options/commands to be executed at startup: ------------- */
  16. /* DCD.Startup="-local -select -partialmatch -uppercase --" is default      */
  17.    DCD.Startup=""
  18. /* ------------------------------------------------------------------------ */
  19.  
  20. /* --------------------- Initialize some variables ------------------------ */
  21. DCD.Global=0                              /* local drive (0=local,1=global) */
  22. DCD.Next=0                  /* user selects possibilities (0=select,1=next) */
  23. DCD.FullMatch=0              /* partial match (0=partial match,1=fullmatch) */
  24. DCD.Case=0             /* not case sensitive (0=not sensitive, 1=sensitive) */
  25. DCD.Exp=0                                  /* expression mode (0=off, 1=on) */
  26. DCD.Rescan=0                                        /* rescan (0=no, 1=yes) */
  27. DCD.Separator='-'     /* no conversion ('/'=\ to /, '\'= / to \, '-'=as is) */
  28. DCD.Grep=1               /* use grep for wildcard expressions (0=no, 1=yes) */
  29. DCD.RegEx=0       /* use <dir> as regular expression for grep (0=no, 1=yes) */
  30. DCD.GrepOpt=''                                    /* Options passed to grep */
  31. call DCD_Color                           /* initialize DCD.Color* variables */
  32. DCD.Env='OS2ENVIRONMENT'                          /* May be useful later... */
  33. DCD.Trc='Off'                               /* No error tracing per default */
  34. /* ------------------------------------------------------------------------ */
  35.  
  36. If RxFuncQuery('SysLoadFuncs') then
  37.    Do
  38.       call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  39.       call SysLoadFuncs
  40.    End
  41.  
  42. signal on halt name DCD_Halt
  43.  
  44. parse arg DCD.CmdLin
  45. if DCD.CmdLin=''; then call DCD_Exit 1 /* Missing input */
  46.  
  47. /* Test configuration (DCD environment variable and DCD.Startup string)     */
  48. call WhoAmI                  /* get source DCD.Src.Drv, Path, Name, and Ext */
  49. DCD.CmdLin=value(DCD.Src.Name,,DCD.Env)' 'DCD.CmdLin
  50. DCD.CmdLin=DCD.Startup' 'DCD.CmdLin
  51. DCD.CmdLin=strip(DCD.CmdLin,'L')
  52.  
  53. DCD.List=DCD.Src.Drv||DCD.Src.Path||DCD.Src.Name'.LST'
  54. DCD.DriveMap=SysDriveMap()                          /* All drives available */
  55. DCD.Match=''                                      /* No match to start with */
  56.  
  57. /* Do some stuff */
  58. if DCD.CmdLin=''; then call DCD_Exit 1         /* missing input, suggest -? */
  59. do forever
  60.    If (substr(DCD.CmdLin,1,1)='-'|substr(DCD.CmdLin,1,1)='/')&\DCD.Exp; Then Do
  61.       Call DCD_Option
  62.       Trace Value DCD.Trc     /* sorry, this needs to be in main routine... */
  63.       End
  64.    Else Do                                    /* try to find and change dir */
  65.       DCD.Dir=DCD_GetArg('Change to directory: ')
  66.       if DCD.CmdLin<>''; then do                 /* all input is wanted dir */
  67.          DCD.Dir=DCD.Dir' 'DCD.CmdLin; DCD.CMdLin=''; end
  68.       DCD.CurDir=directory()                                 /* current dir */
  69.       if \DCD.Case; then DCD.CurDir=DCD_UpCase(DCD.CurDir)
  70.       DCD.CurDrv=filespec('D',DCD.CurDir)                  /* current drive */
  71.       if \DCD.RegEx; then Do /* no fiddling when -regex active! */
  72.             if \DCD.Case; then DCD.Dir=DCD_UpCase(DCD.Dir)
  73.        call DCD_Separator                           /* convert \, /, etc. */
  74.        DCD.Drv=filespec('D',DCD.Dir)                      /* wanted drive */
  75.        if DCD.Drv<>''; then DCD.Global=0   /* drive spec, override Global */
  76.        else; if \DCD.Global; then DCD.Drv=DCD.CurDrv       /* local drive */
  77.        if \DCD.Global&\Valid_Drive(DCD.Drv); then call DCD_Exit 4 DCD.Drv
  78.        DCD.Dir=filespec('P',DCD.Dir)||filespec('N',DCD.Dir)  /* path+name */
  79.        DCD.Drv.Dir=DCD.Drv||DCD.Dir               /* drive, path and name */
  80.       End 
  81.       DCD.FullDir=''                   /* initialize full dir for changedir */
  82.       call Test_Dots                    /* check if DCD.Dir is of .\.. form */
  83.       if DCD.FullDir<>''; then call Change_Dir(DCD.FullDir)
  84.       /* time to make a match with the list file... */
  85.       call DCD_List('EXIST')        /* Check existence of directory listing */
  86.       if Verify(DCD.Dir,'*?',M)<>0|DCD.RegEx; then 
  87.          call DCD_Wild                                 /* Wildcard handling */
  88.       else
  89.          call DCD_Match
  90.       if DCD.FullDir<>''; then
  91.          call Change_Dir(DCD.FullDir)
  92.       else do
  93.          say "I wouldn't expect you to end here... I'll try "DCD.Drv.Dir
  94.          call Change_Dir(DCD.Drv.Dir)
  95.       end
  96.    end
  97. end
  98. return
  99.  
  100. /* ===========================================================================
  101. DCD_Option: procedure to check command line options.
  102. Usage: call DCD_Option
  103.        Input:  DCD.CmdLin
  104.        Output: DCD.CmdLin (without first argument)
  105. =========================================================================== */
  106. DCD_Option: procedure expose DCD.
  107. parse var DCD.CmdLin Opt DCD.CmdLin
  108. Opt = translate(substr(Opt,2))                /* throw away first character */
  109. select
  110.    when abbrev('?',Opt,1);           then call DCD_Help
  111.    when abbrev('HELP',Opt,1);        then call DCD_Help VERBOSE
  112.    when abbrev('GLOBAL',Opt,1);      then DCD.Global=1
  113.    when abbrev('LOCAL',Opt,1);       then DCD.Global=0
  114.    when abbrev('NEXT',Opt,1);        then DCD.Next=1
  115.    when abbrev('RR',Opt,2);          then DCD.Next=1
  116.    when abbrev('ROUNDROBIN',Opt,2);  then DCD.Next=1
  117.    when abbrev('SELECT',Opt,2);      then DCD.Next=0
  118.    when abbrev('SCAN',Opt,1);        then call DCD_Scan
  119.    when abbrev('RESCAN',Opt,2);      then Do; DCD.Rescan=1; call DCD_Scan; End
  120.    when abbrev('LISTFILE',Opt,2)|abbrev('LST',Opt,3);
  121.                 then DCD.List=DCD_GetArg('Alternate directory list: ')
  122.    when abbrev('FULLMATCH',Opt,1);   then DCD.FullMatch=1
  123.    when abbrev('PARTIALMATCH',Opt,1);then DCD.FullMatch=0
  124.    when abbrev('UPPERCASE',Opt,2);   then DCD.Case=0
  125.    when abbrev('LOWERCASE',Opt,3);   then DCD.Case=1
  126.    when abbrev('PUSHDIR',Opt,2);     then call DCD_PushDir
  127.    when abbrev('POPDIR',Opt,2);      then call DCD_PopDir
  128.    when abbrev('COLOR',Opt,5);       then call DCD_Color ON
  129.    when abbrev('EXPRESSION',Opt,1);  then DCD.Exp=1
  130.    when abbrev('NOGREP',Opt,6);      then DCD.Grep=0
  131.    when abbrev('REGEX',Opt,5);       then DCD.RegEx=1
  132.    when abbrev('GREPOPT',Opt,5);     then 
  133.         DCD.GrepOpt=DCD.GrepOpt' 'DCD_GetArg('Option(s) for grep: ')
  134.    when abbrev('VERSION',Opt,1);     then call DCD_Version
  135.    when abbrev('$TRACE',Opt,6);      then DCD.Trc=DCD_GetArg('Trace level: ')
  136.    when datatype(Opt,'W') & Opt>0;   then call DCD_UpTree Opt
  137.    when Opt='\'|Opt='/'|Opt='-';     then DCD.Separator=Opt
  138.    otherwise; call DCD_Exit 2 '-'Opt
  139. end
  140. return
  141.  
  142. /* ===========================================================================
  143. DCD_Version: display version number and bag out
  144. =========================================================================== */
  145. DCD_Version: procedure expose DCD.
  146. call charout , DCD.ColorNormal||DCD.Version
  147. call DCD_Exit 0
  148. return
  149.  
  150. /* ===========================================================================
  151. WhoAmI: determine source, DCD.Src.Drv, Src.Path, Src.Name, Src.Ext
  152. =========================================================================== */
  153. WhoAmI: procedure expose DCD.
  154. parse upper source . . DCD.Src
  155. DCD.Src.Drv=filespec('D',DCD.Src)                                  /* drive */
  156. DCD.Src.Path=filespec('P',DCD.Src)                                  /* path */
  157. DCD.Src.Name=filespec('N',DCD.Src)                              /* name.ext */
  158. DCD.Src.Ext=right(DCD.Src.Name,lastpos('.',DCD.Src.Name))            /* ext */
  159. DCD.Src.Name=left(DCD.Src.Name,lastpos('.',DCD.Src.Name)-1)         /* name */
  160. return
  161.  
  162. /* ===========================================================================
  163. DCD_UpTree: go `up' in the directory tree
  164. Usage: call DCD_UpTree <n>
  165. =========================================================================== */
  166. DCD_UpTree: procedure expose DCD.
  167. parse arg Count
  168. do I=1 to Count; if directory('..')=''; then Leave; end
  169. call DCD_Exit 0
  170. return
  171.  
  172. /* ===========================================================================
  173. DCD_PushDir: push current dir in environment variable (DCD_Push)
  174. Usage: call DCD_PushDir
  175.        Input:  none
  176.        Output: none
  177. =========================================================================== */
  178. DCD_PushDir: procedure expose DCD.
  179. PushDir=value(DCD.Src.Name'_Push',directory(),DCD.Env)
  180. return
  181.  
  182. /* ===========================================================================
  183. DCD_PopDir: jump back to directory set by environment variable.
  184. Usage: call DCD_PopDir
  185.        Input:  environment variable DCD_Push
  186.        Output: error if DCD_Push not set, else call Change_Dir
  187. =========================================================================== */
  188. DCD_PopDir: procedure expose DCD.
  189. PopDir=value(DCD.Src.Name'_Push',,DCD.Env)
  190. if PopDir='' then call DCD_Exit 18
  191. call Change_Dir(PopDir)
  192. return 
  193.  
  194. /* ===========================================================================
  195. DCD_Separator: convert directory separators
  196. =========================================================================== */
  197. DCD_Separator: procedure expose DCD.
  198. select
  199.    when DCD.Separator='/'; then DCD.Dir=translate(DCD.Dir,'/','\')
  200.    when DCD.Separator='\'; then DCD.Dir=translate(DCD.Dir,'\','/')
  201.    when DCD.Separator='-'; then nop;
  202.    otherwise; call DCD_Exit 14 DCD.Separator
  203. end
  204. return
  205.  
  206. /* ===========================================================================
  207. DCD_UpCase: convert some variables to uppercase
  208.             attempt foreign language characters as well (code page 850)
  209.             Uppercase equivalent of characters after A-Z:
  210.             `A 'A ^A "A CC `E 'E ^E "E `I 'I ^I "I ~N `O 'O "O ^O "O ~O `U 'U
  211.             ^U 'Y AE \O AA ETH THORN
  212. =========================================================================== */
  213. DCD_UpCase: procedure
  214. parse arg Up
  215. UpChr='ABCDEFGHIJKLMNOPQRSTUVWXYZ╖╡╢ÄÇ╘É╥╙▐╓╫╪ÑπαΓÖσδΘΩÜφÆ¥Å╤Φ'
  216. LoChr='abcdefghijklmnopqrstuvwxyzàáâäçèéêëìíîïñòóôöΣùúûü∞æ¢å╨τ'
  217. return translate(Up,UpChr,LoChr)
  218.  
  219. /* ===========================================================================
  220. Test_Dots: procedure to test if directory consists of dots and (back)slashes
  221. Usage: call Test_Dots
  222.        Input:  DCD.Dir     path and name of directory
  223.                DCD.Drv.Dir drive, path and name of directory
  224.        Output: DCD.FullDir will bet set to DCD.Drv.Dir on success
  225. =========================================================================== */
  226. Test_Dots: procedure expose DCD.
  227. do I = 1 to length(DCD.Dir)
  228.    if verify(substr(DCD.Dir,I,1),'.\/')<>0 then return /* exit if not '.\/' */
  229. end I
  230. select /* test a few invalid combinations */
  231.    when pos('...', DCD.Dir)<>0; then call DCD_Exit 9 DCD.Dir
  232.    when pos('....',DCD.Dir)<>0; then call DCD_Exit 9 DCD.Dir
  233.    when pos('\\',  DCD.Dir)<>0; then call DCD_Exit 9 DCD.Dir
  234.    when pos('//',  DCD.Dir)<>0; then call DCD_Exit 9 DCD.Dir
  235.    when pos('/\',  DCD.Dir)<>0; then call DCD_Exit 9 DCD.Dir
  236.    when pos('\/',  DCD.Dir)<>0; then call DCD_Exit 9 DCD.Dir
  237.    otherwise DCD.FullDir=DCD.Drv.Dir
  238. end
  239. return
  240.  
  241. /* ===========================================================================
  242. DCD_Match: procedure to test DCD.Drv and DCD.Dir against directories
  243.            in DCD.List file.
  244. Usage: call DCD_Match
  245.        Input:  DCD.Drv, DCD.Dir
  246.                DCD.List: file with directory list
  247.                DCD.Global, DCD.Next, DCD.FullMatch: logical variables.
  248.        Output: DCD.FullDir: full directory name desired or empty string
  249.                DCD.Match: directory name for (last) full match.
  250.        Note:   output is in fact generated by calling DCD_SelDir.
  251. =========================================================================== */
  252. DCD_Match: procedure expose DCD.
  253. if SysFileSearch(DCD.Dir, DCD.List, Match1)<>0; then call DCD_Exit 10 RC
  254. J=0                                                        /* match counter */
  255. do I = 1 to Match1.0
  256.    Tmp=Match1.I; if \DCD.Case then Tmp=DCD_Upcase(Tmp)
  257.    if \DCD.Global; then                                /* drive must match: */
  258.       if DCD.Drv <> filespec('D',Tmp); then iterate
  259.         /* Make sure match occurs without trailing '\' (indicating subdirs) */
  260.    if lastpos(DCD.Dir,Tmp)+length(DCD.Dir)<=lastpos('\',Tmp);
  261.       then iterate
  262.    if filespec('N',DCD.Dir)<>filespec('N',Tmp); then  /* no full match */
  263.       do; if DCD.FullMatch; then iterate; end
  264.    else                                                       /* full match */
  265.       if \DCD.FullMatch; then DCD.Match=Match1.I          /* set best match */
  266.    J=J+1; Match2.J=Match1.I          /* something must match if we get here */
  267. end I
  268. Match2.0=J
  269. call DCD_SelDir
  270. return
  271.  
  272. /* ===========================================================================
  273. DCD_Wild: wildcard matching of directory names
  274. Usage: call DCD_wild
  275.        Input:  DCD.Drv.Dir DCD.Drv DCD.Dir (DCD.CurDrv)
  276.                DCD.Grep  - use grep for wildcard matching
  277.                DCD.RegEx - 0: cmd.exe wildcard emulation (of * and ?)
  278.                            1: pass DCD.Drv.Dir to grep as regular expression
  279.        Output: DCD.Fulldir (by calling DCD_SelDir which uses stem Match2)
  280.  
  281. This is a bit of a clutch, rescanning the drive without supporting the 
  282. -global option.
  283. This because SysFileTree supports wildcard searching, SysFileSearch doesn't,
  284. and I don't want to write my own code for wildcard matching...
  285. However, this is not how I want it: only the name part of the dir will be
  286. matched. E.g. 'dcd f*' would match foobar, 'dcd f*r' will not match, whereas
  287. I would like it to match both foobar and foo\bar :-(
  288. =========================================================================== */
  289. DCD_Wild: procedure expose DCD.
  290. If DCD.FullMatch Then Do;           /* full match with wildcards impossible */
  291.    Call DCD_Warn 2 DCD.Drv.Dir; DCD.FullMatch=0; End
  292.  
  293. /* 4 possibilities:
  294.    - RegEx=1, Grep=1: grep noconversion
  295.    - RegEx=1, Grep=0: bag out
  296.    - RegEx=0, Grep=1: grep converted string
  297.    - RegEx=0, Grep=0: no grep
  298. */
  299.  
  300. If \DCD.Grep; Then Do /* scan single DCD.Drv */
  301.    If DCD.RegEx; Then call DCD_Exit 17 /* Options contradict */
  302.    If DCD.Global Then Do /* no global, stay on current drive */
  303.       Call DCD_Warn 1 DCD.Drv.Dir; DCD.Drv=DCD.CurDrv; End
  304.    if DCD.Case then call DCD_Warn 3 DCD.Drv'\'DCD.Dir
  305.    If SysFileTree(DCD.Drv'\'DCD.Dir, Match2, 'SDO')<> 0; Then Do
  306.       Say; Call DCD_Exit 5 Drive; End
  307.    End
  308. Else Do
  309.    Grep = SysSearchPath('PATH','GREP.EXE')
  310.    If Grep=''; Then call DCD_Exit 16 /* grep.exe not found on the path */
  311.    If \DCD.Case; Then DCD.GrepOpt='-i 'DCD.GrepOpt
  312.    '@echo off'
  313.    If DCD.RegEx Then 
  314.       Do /* nothing fancy, ignore all settings */
  315.          GrepDir = DCD.Dir; DCD.Drv.Dir = DCD.Dir
  316.       End
  317.    Else 
  318.       GrepDir = CvtOS2toGNU(DCD.Drv.Dir)
  319.    Grep DCD.GrepOpt GrepDir DCD.List '| RxQueue' /* output to queue */
  320.    Match2.0 = Queued()
  321.    Do I=1 to Match2.0
  322.       Parse Pull Match2.I
  323.    End
  324. End
  325. call DCD_SelDir
  326. return
  327.  
  328. /* =========================================================================== 
  329. DCD_SelDir: let user select a directory
  330. Usage: call DCD_SelDir
  331.        Input:  Match2      - stem containing directories
  332.        Output: DCD.FullDir - full directory name on success, otherwise exit
  333. =========================================================================== */
  334. DCD_SelDir: procedure expose DCD. Match2.
  335.  
  336. if Match2.0=0 then; do
  337.    /* no match, last resort: try to switch anyway ... */
  338.    if directory(DCD.Drv.Dir)<>''; then exit 
  339.    if \DCD.FullMatch; then call DCD_Exit 11 DCD.Drv.Dir         /* no match */
  340.                       else call DCD_Exit 12 DCD.Drv.Dir
  341.    end
  342. if Match2.0=1 then; do; DCD.FullDir=Match2.1; return; end     /* single hit */
  343. /* more hits if we get here */
  344. if \DCD.Next; then do;                                      /* user selects */
  345.    parse value SysTextScreenSize() with ScrnRows .           /* screen size */
  346.    if Match2.0>ScrnRows-1; then
  347.       say "Read quickly: more choices than I can show!"
  348.    if Match2.0>36; then
  349.       say "More choices than I can handle! Use -n option or specify better."
  350.    Match2.0=min(36,ScrnRows-1,Match2.0)
  351.    NumAlph='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'             /* 36 choices */
  352.    do I = 1 to Match2.0                                     /* show choices */
  353.       say DCD.ColorPrompt||substr(NumAlph,I,1),
  354.           DCD.ColorNormal||Match2.I; 
  355.    end I
  356.    call charout , DCD.ColorPrompt
  357.    if DCD.Match=''; then                                          /* prompt */
  358.       call charout , "Hit choice or Esc: "DCD.ColorInput
  359.    else 
  360.       call charout , "Hit choice, Esc, or Enter|Space for "DCD.Match":",
  361.       DCD.ColorInput
  362.    Key=translate(SysGetKey())                                  /* get reply */
  363.    if Key='1B'x; then; call DCD_Exit 0                         /* 1B=Escape */
  364.    if (Key='0D'x|Key='20'x) & DCD.Match<>''; then do  /* 0D=Enter, 20=Space */
  365.          DCD.FullDir=DCD.Match; return; end
  366.    /* if we get here, real selection was made */
  367.    Choice=pos(Key,NumAlph)                                /* check if valid */
  368.    if Choice>0 & Choice<=Match2.0; then DCD.FullDir=Match2.Choice
  369.    else do; say ''; call DCD_Exit 13 Key; end   /* any other key is invalid */
  370. end /* do user selects */
  371. else do                                                 /* round robin mode */
  372.    Choice=1                            /* default first entry in match list */
  373.    do I = 1 to Match2.0            /* check if current dir is in match list */
  374.       if DCD.CurDir=Match2.I; then do                             /* if so, */
  375.          if I=Match2.0 then Choice=1; else Choice=I+1  /* pick next in list */
  376.          leave                         /* and leave loop to set DCD.FullDir */
  377.       end
  378.    end I
  379.    DCD.FullDir=Match2.Choice
  380. end
  381. return
  382.  
  383. /* ===========================================================================
  384. CvtOS2toGNU: try to mimic OS/2 wildcards (? and *) for GNU regular expressions
  385. Usage: GNUregex = CvtOS2toGNU(OS2regex)
  386. =========================================================================== */
  387. CvtOS2toGNU: Procedure
  388. Parse Arg OS2
  389.  
  390. /* Say "GREP string to be converted: "OS2 */
  391.  
  392. GNU=''
  393. Do I=1 to Length(OS2)
  394.    C=SubStr(OS2,I,1)
  395.    Select
  396.       When Verify(C,'.\')=0; Then GNU=GNU'\'C
  397.       When C='?'; Then GNU=GNU'.'
  398.       When C='*'; Then GNU=GNU'.*'
  399.       When C=' '; Then GNU=GNU'[[:space:]]'
  400.       When C=':'; Then GNU=GNU':.*'
  401.       Otherwise; GNU=GNU||C
  402.       End
  403. End
  404. If Right(GNU,1)<>'*'; Then
  405.    GNU=GNU'$'
  406. Return GNU
  407.  
  408. /* ===========================================================================
  409. Change_Dir: try to change directory and then exit (with or without error msg).
  410. Usage: call Change_Dir(directory)
  411. =========================================================================== */
  412. Change_Dir: procedure expose DCD.
  413. parse arg Dir
  414. if directory(Dir)='' then call DCD_Exit 8 Dir /* error   */
  415. call DCD_Exit 0                               /* success */
  416. return
  417.  
  418. /* ===========================================================================
  419. DCD_List: function to test or delete DCD.List file
  420. Usage: call DCD_List('MODE');
  421.        Input:  MODE = EXIST: check if DCD.List exists
  422.                MODE = DELETE: delete DCD.List
  423.        Action: bag out if anything goes wrong
  424. =========================================================================== */
  425. DCD_List: procedure expose DCD.
  426. parse upper arg MODE
  427. if stream(DCD.List,'c','query exists')=''; then do /* file does not exist */
  428.    if MODE='EXIST'; then call DCD_Exit 3 DCD.List; end
  429. else do
  430.    if MODE='DELETE'; then
  431.       if sysfiledelete(DCD.List)<>0; then call DCD_Exit 6 DCD.List; end
  432. return
  433.  
  434. /* ===========================================================================
  435. DCD_GetArg: return next argument from command line, prompt if necessary
  436. Usage: Var=DCD_GetArg(Prompt);
  437.        Input:  Prompt     - display text if no CmdLin stack empty
  438.                DCD.CmdLin - CmdLin stack
  439.        Output: Var        - First command from CmdLin stack
  440.                DCD.CmdLin - CmdLin stack without first argument
  441. =========================================================================== */
  442. DCD_GetArg: procedure expose DCD.
  443. parse var DCD.CmdLin Var DCD.CmdLin
  444. if Var=''; then do;
  445.    parse arg Prompt
  446.    call charout , DCD.ColorPrompt||Prompt||DCD.ColorInput; 
  447.    pull DCD.CmdLin; parse var DCD.CmdLin Var DCD.CmdLin;
  448.    if Var=''; then call DCD_Exit 15;         /* persistently no input, quit */
  449.    end
  450. return Var
  451.  
  452. /* ===========================================================================
  453. DCD_Scan: procedure to scan drives for directories and save to file
  454. Usage: call DCD_Scan
  455.        Input:  DCD.CmdLin: string with drives
  456.        Output: DCD.List file containing directory structure
  457. =========================================================================== */
  458. DCD_Scan: procedure expose DCD.
  459. Drives=DCD_Getarg('Drives to scan: ')
  460. if \DCD.Case; then Drives=DCD_UpCase(Drives)
  461.  
  462. /* first check if drives are allowed */
  463. Drives.ToDo=''
  464. do I = 1 to length(Drives)
  465.    Drive=substr(Drives,I,1)
  466.    if verify(Drive,'ABCDEFGHIJKLMNOPQRSTUVWXYZ')=0; then do   /* test [A-Z] */
  467.       Drive=Drive':'
  468.       if \Valid_Drive(Drive); then call DCD_Exit 4 Drive
  469.       if Pos(Drive,Drives.ToDo)=0; then Drives.ToDo=Drives.ToDo||Drive' '
  470.                                /* eliminate double occurences of Drive */
  471.    end
  472. end I
  473.  
  474. If DCD.Rescan then
  475.    Do
  476.       /* Read in the old list and close it */
  477.       Do i=1 while Lines(DCD.List)
  478.          OldList.i=LineIn(DCD.List)
  479.       End
  480.       Call LineOut DCD.List
  481.       OldList.0=i-1
  482.    End
  483. Else
  484.    OldList.0=0
  485.  
  486. /* bubble sort of drives here, double occurences already eliminated */
  487. Do i=1 to Words(Drives.ToDo)-1
  488.    Do j=i+1 to Words(Drives.ToDo)
  489.       D1=Word(Drives.ToDo,i)
  490.       D2=Word(Drives.ToDo,j)
  491.       If D1>D2 then 
  492.          Do /* only possible because words have same length */
  493.             Drives.Todo=Overlay(D2,Drives.ToDo,WordIndex(Drives.ToDo,i))
  494.             Drives.Todo=Overlay(D1,Drives.ToDo,WordIndex(Drives.ToDo,j))
  495.          End
  496.    End j   
  497. End i
  498.  
  499. /* then do the scanning */
  500. N_Drives = 0
  501. M_Ix     = 1 /* Merge index */
  502. call charout , DCD.ColorNormal
  503. If DCD.Rescan then
  504.    call charout , "Refreshing drive"
  505. Else
  506.    call charout , "Scanning drive"
  507. do I = 1 to Words(Drives.ToDo)
  508.    Drive=Word(Drives.ToDo,I)
  509.    call charout , ' '||Drive
  510.    N_Drives = N_Drives+1
  511.    if sysfiletree(Drive"\", DirList.N_Drives, 'SDO')<> 0; then do
  512.       say; call DCD_Exit 5 Drive
  513.    end
  514. end I
  515.  
  516. /* finally write directory list to file */
  517. call DCD_List('DELETE')         /* find DCDLST file; delete if necessary */
  518. If DCD.Rescan then
  519.    call charout , " ... updating "DCD.List" ... "
  520. Else
  521.    call charout , " ... writing "DCD.List" ... "
  522. do I = 1 to N_Drives
  523.    Matched=0
  524.    If DCD.Rescan then
  525.       /* Merge in prior information on unscanned drives */
  526.       Do M_Ix=M_Ix to OldList.0 Until Matched
  527.          Select
  528.             When Left(OldList.M_Ix,1)<Left(Word(Drives.ToDo,I),1) then
  529.                /* Write this record */
  530.                if lineout(DCD.List, OldList.M_Ix)<>0; 
  531.                   then call DCD_Exit(7,'DCD.List')
  532.             When Left(OldList.M_Ix,1)=Left(Word(Drives.ToDo,I),1) then
  533.                /* Bypass this record, alphabetical order assumed */
  534.                NOP
  535.             Otherwise
  536.                /* It's greater, so we have an insertion point */
  537.                Matched=1
  538.          End /* Select */
  539.       End /* Do */
  540.    do J = 1 to DirList.I.0
  541.       if lineout(DCD.List, DirList.I.J)<>0; then call DCD_Exit(7,'DCD.List')
  542.    end J
  543. end I
  544. If DCD.Rescan then
  545.    Do M_Ix=M_Ix to OldList.0
  546.       /* Write remaining records */
  547.       if lineout(DCD.List, OldList.M_Ix)<>0; then call DCD_Exit(7,'DCD.List')
  548.    End /* Do */
  549. call stream DCD.List,'C','CLOSE' /* close file */
  550. say "done."DCD.ColorReset
  551. if DCD.CmdLin='' then call DCD_Exit 0
  552. return
  553.  
  554. /* ===========================================================================
  555. Valid_Drive: logical function to test valid drive
  556. Usage: result=Valid_Drive(drive:)
  557.        Input:  drive: drive letter followed by colon
  558.        Output: result=0 (invalid drive); result=1 (valid drive)
  559. =========================================================================== */
  560. Valid_Drive: procedure expose DCD.
  561. parse upper arg Drive
  562. Drive=filespec('D',Drive)
  563. return verify(Drive,DCD.DriveMap)=0
  564.  
  565. /* ===========================================================================
  566. DCD_Color: set colors for output
  567. Usage: call DCD_Color <OnOff>
  568.        Input:  Onoff character string, if ON set color, otherwise no color
  569.        Output: DCD.ColorNormal escape sequence to set color for normal text
  570.            DCD.ColorInput  idem, for user input text
  571.            DCD.ColorBold   idem, for bold text
  572.            DCD.ColorPrompt idem, for prompts
  573.            DCD.ColorError  idem, for error messages
  574.            DCD.ColorReset  escape sequence to reset text attributes
  575. NOTE: requires ANSI ON
  576. =========================================================================== */
  577. DCD_Color: procedure expose DCD.
  578. parse upper arg OnOff
  579.  
  580. if OnOff\='ON' then do
  581.    DCD.ColorNormal = ''
  582.    DCD.ColorInput  = ''
  583.    DCD.ColorBold   = '' 
  584.    DCD.ColorPrompt = ''
  585.    DCD.ColorError  = ''
  586.    DCD.ColorReset  = ''
  587.    end /* Do */
  588. else do   
  589.    /* FG_Color: foreground color (according to ISO 6429 standard)
  590.       BG_Color: background color (according to ISO 6429 standard)
  591.       At_Attr:  text attribute 
  592.    */
  593.    FG_Black  ='30' ; BG_Black  ='40' ; At_Off    ='0'
  594.    FG_Red    ='31' ; BG_Red    ='41' ; At_Bold   ='1'
  595.    FG_Green  ='32' ; BG_Green  ='42' ; At_Under  ='4'
  596.    FG_Yellow ='33' ; BG_Yellow ='43' ; At_Blink  ='5'
  597.    FG_Blue   ='34' ; BG_Blue   ='44' ; At_Reverse='7'
  598.    FG_Magenta='35' ; BG_Magenta='45' ; At_Conceal='8'
  599.    FG_Cyan   ='36' ; BG_Cyan   ='46'
  600.    FG_White  ='37' ; BG_White  ='47'
  601.     
  602.    Esc=D2C(27) /* escape character */
  603.     
  604.    DCD.ColorNormal = Esc'['At_Off';'FG_White';'BG_Blue'm'
  605.    DCD.ColorInput  = Esc'['At_Bold';'FG_Yellow';'BG_Blue'm'
  606.    DCD.ColorBold   = Esc'['At_Bold';'FG_White';'BG_Blue'm'
  607.    DCD.ColorPrompt = Esc'['At_Bold';'FG_Green';'BG_Blue'm'
  608.    DCD.ColorError  = Esc'['At_Bold';'At_Blink';'FG_Yellow';'BG_Red'm'
  609.    DCD.ColorReset  = Esc'['At_Off'm'
  610.    end /* Do */
  611. return
  612.  
  613. /* ===========================================================================
  614. DCD_Help: procedure to list help and then exit
  615. Usage: call DCD_Help MODE
  616.        Input:  MODE='' short help; MODE='VERBOSE' long help
  617. =========================================================================== */
  618. DCD_Help: procedure expose DCD.
  619. parse arg VERBOSE
  620. B=DCD.ColorBold   /* abbraviate colors */
  621. N=DCD.ColorNormal
  622. say N
  623. say "DCD disk change directory usage:"
  624. say B"DCD [-?|-help] [-scan|-rescan <drives>] [-global|-full|-next]", 
  625.         "[-opt] -<n>|<dir>"
  626. if VERBOSE=''; then Do 
  627.    say N"Type DCD -help for more help.",
  628.        "Read DCD.DOC for all options."; call DCD_Exit 0 
  629.    End
  630. say N
  631. say "Change directory to <dir>, in which `<dir>' is part of a directory name"
  632. say "(* and ? allowed) or <n> times up the tree.",
  633.     "Options start with `-' or `/'." 
  634. say "Startup options may be configured by setting the environment variable",
  635.      B||DCD.Src.Name||N"."
  636. say N
  637. say B"-?"N"|"||B"-H"N"elp|"||B"-V"N"ersion     short help | long help |",
  638.      "display version number."
  639. say B"-G"N"lobal|"||B"-L"N"ocal        match directory on all | local drive(s)."
  640. say B"-F"N"ullmatch            require full match of directory name."
  641. say B"-P"N"artialmatch         partial match of directory name suffices."
  642. say B"-N"N"ext                 do not query, jump to next match."
  643. say B"-PU"N"shdir|"||B"-PO"N"pdir      remember current dir |",
  644.      "jump back to pushed dir."
  645. say B"-UP"N"percase|"||B"-LOW"N"ercase no case sensitivity (<dir> uppercase) |",
  646.      "case sensitivity."
  647. say B"-\, -/, --"N"            convert / to \, \ to /, or no conversion."
  648. say B"-LI"N"st <file>          use alternate directory list from <file>."
  649. say B"-S"N"can <drives>        scan drive(s); e.g., <drives>=cdE:fg."
  650. say B"-RE"N"scan <drives>      rescan drives, retain previous scan data."
  651. say B"-E"N"xpression <dir>     search for <dir>, useful if <dir> begins with -."
  652. say B"-NOGREP"N"               do not use grep for wildcard matching."
  653. say B"-REGEX"N"                force grep with <dir> as regular expression."
  654. say B"-GREPO"N"pt <opt>        pass <opt> to grep command."
  655. say B"-COLOR"N"                attempt to color your world..."
  656. call DCD_Exit 0
  657. return
  658.  
  659. /* ===========================================================================
  660. DCD_Warn: procedure to give a warning message
  661. Usage: call DCD_Warn Errcode Txt
  662.        Input:  Warning code (0=no warning)
  663.                Txt    text used in some of the warning messages
  664.        Output: None
  665. =========================================================================== */
  666. DCD_Warn: procedure expose DCD.
  667. parse arg Wrn Txt
  668. if Wrn <> 0; then do
  669.    if Txt='0D'x|Txt='08'x; then Txt=''
  670.    select
  671.      when Wrn=1; then Txt="No wildcard support for -global ("Txt")."
  672.      when Wrn=2; then Txt="No wildcard support for -fullmatch ("Txt")."
  673.      when Wrn=3; then Txt="Case sensitivity disabled ("Txt")."
  674.      otherwise;       Txt="Something invoked warning "Wrn", but why?"
  675.    end
  676.    say DCD.ColorError"DCD Warning: "Txt DCD.ColorNormal
  677. end
  678. return
  679.  
  680. /* ===========================================================================
  681. DCD_Exit: procedure to exit with error message
  682. Usage: call DCD_Exit Errcode Txt
  683.        Input:  Errcode error code to set (0=no error)
  684.                Txt    text used in some of the error messages
  685.        Output: Errcode
  686. =========================================================================== */
  687. DCD_Exit: procedure expose DCD.
  688. parse arg Err Txt
  689. if Err <> 0; then do
  690.    if Txt='0D'x|Txt='08'x; then Txt=''
  691.    select
  692.      when Err=1;  then Txt="Missing input. Try DCD -?"
  693.      when Err=2;  then Txt="Unrecognized option ("Txt")."
  694.      when Err=3;  then Txt="Missing file ("Txt"). Scan disks."
  695.      when Err=4;  then Txt="Invalid drive ("Txt")."
  696.      when Err=5;  then Txt="SysFileTree error scanning "Txt"."
  697.      when Err=6;  then Txt="SysFileDelete error for "Txt"."
  698.      when Err=7;  then Txt="Could not write to file "Txt"."
  699.      when Err=8;  then Txt="Invalid directory ("Txt"). Scan disks."
  700.      when Err=9;  then Txt="Invalid directory construct ("Txt")."
  701.      when Err=10; then Txt="SysFileSearch error ("Txt")."
  702.      when Err=11; then Txt="No match ("Txt"). Retype or scan disks."
  703.      when Err=12; then Txt="No full match ("Txt"). Retype or scan disks."
  704.      when Err=13; then Txt="Invalid selection ("Txt")."
  705.      when Err=14; then Txt="Invalid separator ("Txt")."
  706.      when Err=15; then Txt="No input. I quit."
  707.      when Err=16; then Txt="Grep required but not found. Use -nogrep."
  708.      when Err=17; then Txt="-regex and -nogrep contradictory."
  709.      when Err=18; then Txt=DCD.Src.Name"_Push environment variable not set."
  710.      when Err=99; then Txt="Sorry, function not implemented."
  711.      otherwise;        Txt="Something invoked error "Err", but why?"
  712.    end
  713.    call charout , DCD.ColorError"DCD Error: "Txt
  714. end
  715. if DCD.CmdLin<>''; then do;
  716.    say 
  717.    call lineout , "DCD Error: Command line ignored ("DCD.CmdLin")."
  718.    end
  719. call charout , DCD.ColorReset
  720. exit Err
  721. return
  722.  
  723. /* ===========================================================================
  724. DCD_Halt: display a random message on ctl_break (called by signal on halt)
  725. =========================================================================== */
  726. DCD_Halt:
  727. Msg.0=5
  728. Msg.1="Ctl_break is wonderful!"
  729. Msg.2="Ctl_Break for the impatient!"
  730. Msg.3="Ouch!"
  731. Msg.4="Your wish is my command: I quit."
  732. Msg.5="Bye bye!"
  733. N=random(1,Msg.0)
  734. say  DCD.ColorError||Msg.N||DCD.ColorReset
  735. /* ============================ end of DCD.CMD ============================ */
  736.